(*
Arnaud Aujon 	AUJA31018906
Francis Chabot 	CHAF11108507

 *)

(* file: main.ml *)
(* Assumes the evalr file is "grammar.mly"
and the lexer file is "lexer.mll". *)

open Printf
open List
open Lexer

open Type
open Variable
open Display

let function_return : Type.expr ref = ref  (Int(4518964)) ;;

(* pow x p : int -> int -> int 
return x^p
*)
let pow x p =
        let rec pow_int a b res =
                match b with
                  0 -> 1
                | 1 -> res
                | b -> if ( b < 0 ) then failwith "Error negative pow" 
                       else let t = res * a and r = b-1 in pow_int a r t
        in pow_int x p x
;;

(* eval function declaration *)
let eval_decl_function var arg_list body env = 
	match var with
	  Var(_) -> (* we should check arg type and body here *)
					(add_var var (Decl_Function(var, arg_list, body)) env)
	| _ -> error "function declared with an invalid name"
;;

(* eval int expression *)
let rec eval_int_expr expr env = match expr with
      Int(value) -> value
    | Binary(e1,op,e2) ->
		begin match op with
		  "+" -> eval_int_expr e1 env + eval_int_expr e2 env
		| "-" -> eval_int_expr e1 env - eval_int_expr e2 env
		| "*" -> eval_int_expr e1 env * eval_int_expr e2 env
		| "/" -> eval_int_expr e1 env / eval_int_expr e2 env
		| "**" -> let x = eval_int_expr e1 env and p = eval_int_expr 
                                                   e2 env in pow x p
		| _ -> error ("unknown operator for integer : "^op)
		end
    | Parenthesized(e1) -> eval_int_expr e1 env
    | Function(name, arg_list) -> function_return := eval_function name 
                              arg_list env ; eval_int_expr !function_return env
    (* if x = float, string or others get_var will raise TypeError *)
    | x -> let value = get_var x env in
				begin match value with
					Int(value) -> value
				  | _ -> raise TypeError
				end

(* eval float expression *)
and eval_float_expr expr env = match expr with
	  Float(value) -> value
    | Binary(e1,op,e2) ->
		begin match op with
		  "+" -> eval_float_expr e1 env +. eval_float_expr e2 env
		| "-" -> eval_float_expr e1 env -. eval_float_expr e2 env
		| "*" -> eval_float_expr e1 env *. eval_float_expr e2 env
		| "/" -> eval_float_expr e1 env /. eval_float_expr e2 env
		| "**" -> eval_float_expr e1 env ** eval_float_expr e2 env
		| _ -> error ("unknown operator for float : "^op)
		end
    | Parenthesized(e1) -> eval_float_expr e1 env
    | Function(name, arg_list) ->  eval_float_expr !function_return env
    | x -> let value = get_var x env in
				begin match value with
				  Float(value) -> value
				| _ -> raise TypeError
				end


(* eval string expression *)
and eval_string_expr expr env = match expr with
      String(value) -> value
    | Binary(e1,op,e2) ->
		begin match op with
		 "+" -> eval_string_expr e1 env ^ eval_string_expr e2 env
		| _ -> error ("unknown operator for string : "^op)
		end
	| Function(name, arg_list) -> eval_string_expr !function_return env
	| x -> let value = get_var x env in
				begin match value with
				  String(value) -> value
				| _ -> raise TypeError
				end


(* eval boolean expression *)
and eval_bool_expr expr env = match expr with
      Bool(value) -> value
    | Binary(e1,op,e2) ->
		begin match op with
		  "&&" -> eval_bool_expr e1 env && eval_bool_expr e2 env
		| "||" -> eval_bool_expr e1 env || eval_bool_expr e2 env
		| "==" -> (try eval_int_expr e1 env == eval_int_expr e2 env
					with TypeError -> try eval_float_expr e1 env == 
                                         eval_float_expr e2 env
						with TypeError -> try (compare (eval_string_expr e1 env) 
                                  (eval_string_expr e2 env)) == 0
							with TypeError -> try eval_bool_expr e1 env == 
                                                eval_bool_expr e2 env
								with TypeError -> error ("type error in comparaison '=='"))
		| "!=" -> (try eval_int_expr e1 env == eval_int_expr e2 env
					with TypeError -> try eval_float_expr e1 env <> 
                                                         eval_float_expr e2 env
						with TypeError -> try (compare (eval_string_expr e1 env) 
                                                (eval_string_expr e2 env)) != 0
							with TypeError -> try eval_bool_expr e1 env <> 
                                                          eval_bool_expr e2 env
								with TypeError -> error ("type error in comparaison '!='"))
		| "<" -> (try eval_int_expr e1 env < eval_int_expr e2 env
					with TypeError -> try eval_float_expr e1 env < eval_float_expr e2 env
						with TypeError -> try (compare (eval_string_expr e1 env) 
                                                 (eval_string_expr e2 env)) < 0
							with TypeError -> error ("type error in comparaison '<'"))
		| ">" -> (try eval_int_expr e1 env > eval_int_expr e2 env
					with TypeError -> try eval_float_expr e1 env == 
                                                         eval_float_expr e2 env
						with TypeError -> try (compare (eval_string_expr e1 env) 
                                                 (eval_string_expr e2 env)) > 0
							with TypeError -> error ("type error in comparaison '>'"))
		| _ -> error ("unknown operator for boolean : "^op)
		end
	| Unary(op,e1) ->
		begin match op with
		  "not" | "!" -> not (eval_bool_expr e1 env)
		| _ -> error ("unknown operator for boolean : "^op)
		end
	| Function(name, arg_list) -> eval_bool_expr  !function_return env

    | x -> let value = get_var x env in
				begin match value with
				  Bool(value) -> value
				| _ -> raise TypeError 
				end


(* eval array expression *)
and eval_array_expr expr env = match expr with
	  Array(arr) -> arr
	| Function(name, arg_list) -> eval_array_expr !function_return env
	| v -> let value = get_var v env in
			begin match value with
			  Array(value) -> value
			| _ -> raise TypeError
			end


(* function fun_iter apply eval function to all elements in expr_list 
it returns return value of the function, if 
function doesn't have a return, 0 is returned *)

and fun_iter env expr_list = match expr_list with
	[] -> (Int(0)) (* function doesn't have return *)
  | Return(expr)::tail -> 
			(try let expr2 = eval_int_expr expr env in (Int(expr2)) with TypeError ->
				try let expr2 = eval_float_expr expr env in 
                                               (Float(expr2)) with TypeError ->
					try let expr2 = eval_string_expr expr env in 
                                              (String(expr2)) with TypeError -> 
						try let expr2 = eval_bool_expr expr env in 
                                                (Bool(expr2)) with TypeError ->
							try let expr2 = eval_array_expr expr env in (Array(expr2)) with 
								TypeError -> error "Type error in 'return' statement")
  | head::tail -> let new_env = eval env head in fun_iter new_env tail

(* iter_while do the same as fun_iter but returns environement *) 
and iter_while env expr_list = match expr_list with
	[] -> env
  | head::tail -> let new_env = eval env head in iter_while new_env tail

(* eval function call *)
and eval_function var arg_list env =
	match var with
	  Var(name) -> let _function = get_var var env in
					begin match _function with
					  Decl_Function(_, arg_list_fun, body) -> let new_env = 
                                                        add_var_function name 
                                                        arg_list_fun arg_list
                                                        env in fun_iter 
                                                        new_env body
					| _ -> error ("Try to call `"^name^"` which isn't a function")
					end
	| _ -> error "function called with an invalid identifier"

(* eval if statement *)
and eval_if_struct if_list env =
	match if_list with
	  [] -> env
	| head::tail -> 	
		begin match head with
		  If(cond, expr) -> (try if (eval_bool_expr cond env == true) 
								then begin 
									let new_env = iter_while env expr in new_env
								end
								else eval_if_struct tail env
							with TypeError -> 
                      error "expecting a boolean expression in if statement")
		| Elsif(cond,expr) -> (try if (eval_bool_expr cond env == true) 
								then begin
									let new_env = iter_while env expr in new_env
								end
								else eval_if_struct tail env
							with TypeError -> 
                  error "expecting a boolean expression in elsif statement")
		| Else(expr) -> let new_env = iter_while env expr in new_env
		end

(* eval while statement *)
and eval_while cond expr_list env =
	match eval_bool_expr cond env with
	  true -> let new_env = iter_while env expr_list in 
                                        eval_while cond expr_list new_env
	| false -> env

(* eval for statement *)
and eval_for var start stop expr_list env =
	(* we store new variable in env *)
	let env2 = eval env (Assignment(var, start)) in
	let new_env = iter_while env2 expr_list and idx = get_var var env2 in
	match idx, stop with
		Int(x), Int(y) -> if x+1 <= y then begin
							let env3 = add_var var (Int(x+1)) new_env in eval_for 
                                        var (Int(x+1)) stop expr_list env3
							end else new_env
		| Float(x), Float(y) -> if x+.1. <= y then begin
							let env3 = add_var var (Float(x+.1.)) new_env in eval_for var 
                                             (Float(x+.1.)) stop expr_list env3
							end else new_env
		| _ -> error "Bad condition in for loop"

(* main eval function *)
and eval env expr  = match expr with
	Decl_Function(var, arg_list, body) -> eval_decl_function
                                        var arg_list body env
  | Function(var, arg_list) -> let _ = eval_function var arg_list env in env
  | Assignment(var,expr) ->
			(try let expr2 = eval_int_expr expr env in add_var var 
                                          (Int(expr2)) env with TypeError ->
				try let expr2 = eval_float_expr expr env in add_var var 
                                        (Float(expr2)) env with TypeError ->
					try let expr2 = eval_string_expr expr env in add_var var 
                                      (String(expr2)) env  with TypeError -> 
						try let expr2 = eval_bool_expr expr env in add_var var 
                                         (Bool(expr2)) env  with TypeError ->
							try let expr2 = eval_array_expr expr env in add_var var
                                                      (Array(expr2)) env  with 
								TypeError -> error "Type error in Assignment")
  | Struct_If(if_list) -> eval_if_struct if_list env
  | While(cond, expr_list) -> eval_while cond expr_list env
  | For(var, start, stop, expr_list) -> eval_for var start stop expr_list env
  | Print(str) -> print str env ; env
  | Parenthesized(e1) -> eval env e1
  | _ -> error ("Unexpected statement")
;;


(* main function *)
let main() =
	(* Usage *)
	let argc = Array.length Sys.argv in
  
	if argc == 1 then begin
		printf "%s: No input file\n" Sys.argv.(0);
		exit 1
	end else if argc > 2 then begin
		printf "%s: Too many arguments\n" Sys.argv.(0);
		printf "%s: Usage: %s source.rb\n" Sys.argv.(0) Sys.argv.(0);
		exit 2
	end else
		(*printf "Interpreting : %s\n" Sys.argv.(1);*)
		(* open file *)
		let input = open_in Sys.argv.(1) in
		(* open a lexer buffer *)
		let lexbuf = Lexing.from_channel input in
		try
			let rec parse_file env : (string * expr) list =
				let expr = Grammar.expr Lexer.token lexbuf in
				parse_file (eval env expr)
			in parse_file []
		with
		  Parsing.Parse_error -> (error "Parse error")
		| Lexer.Eof -> 
			close_in input; 
	exit 0
;;

(* run main function *)
let _ = Printexc.print main ()
